// Erlang linked-in driver around libffi
// Written in April of 2007 by Denis Bilenko <denis.bilenko[a]gmail.com>

#include "ffi.h"

#include <stdio.h>
#include <string.h>
#include <malloc.h>

#include "erl_driver.h"
#include "ei.h"

#include "util.h"
#include "types.h"
#include "ei_types.h"
#include "constants.h"

#ifdef _MSC_VER
#define FFI_CALL_RETURN_INT
#endif
#define MY_NAME driver_libffi

#ifndef __WIN32__
#include <dlfcn.h>
#endif

// XXX why erl.exe crashes when delta is not 0 and python does not?
// is it because of alloca?
// see ctypes/callproc.c for meaning of delta

// XXX return {error, enomem} when malloc return 0
// same thing when alloca fails??? (if it is possible to catch the exception)

// not SMP compatible?
static long async_id;
long next_id()
{
    return ++async_id;
}

typedef ErlDrvTermData ErlDriverTerm;

// XXX use these instead of malloc/free (but where are they from?)
// void *sys_alloc(size_t);
// void *sys_realloc(void *, size_t);
// void sys_free(void *);

static int drv_init(void);
static ErlDrvData drv_start(ErlDrvPort port, char *buff);   
static void drv_stop(ErlDrvData handle);
static int drv_call(ErlDrvData drv_data, unsigned int command, char *buf, int len,
                    char **rbuf, int rlen, unsigned int *flags);
static void ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data);

char driver_name[] = "driver_libffi";

ErlDrvEntry driver_entry = {
    drv_init,         /* F_PTR init, N/A */
    drv_start,        /* L_PTR start, called when port is opened */
    drv_stop,         /* F_PTR stop, called when port is closed */
    NULL,             /* F_PTR output, called when erlang has sent */
    NULL,             /* F_PTR ready_input, called when input descriptor ready */
    NULL,             /* F_PTR ready_output, called when output descriptor ready */
    driver_name,      /* char *driver_name, the argument to open_port */
    NULL,             /* F_PTR finish, called when unloaded */
    NULL,  // void* handle
    NULL,             /* F_PTR control, port_command callback */
    NULL,             /* F_PTR timeout, reserved */
    NULL,             /* F_PTR outputv, reserved */
    ready_async, // void (*ready_async)(ErlDrvData drv_data, ErlDrvThreadData thread_data)
    NULL, // void (*flush)(ErlDrvData drv_data);
                                /* called when the port is about to be 
                                   closed, and there is data in the 
                                   driver queue that needs to be flushed
                                   before 'stop' can be called */
    drv_call, // Works mostly like 'control', a syncronous
          // call into the driver.
    NULL, // void (*event)(ErlDrvData drv_data, ErlDrvEvent event,
          //        ErlDrvEventData event_data);
                                /* Called when an event selected by 
                                   driver_event() has occurred */
    ERL_DRV_EXTENDED_MARKER,
    ERL_DRV_EXTENDED_MAJOR_VERSION,
    ERL_DRV_EXTENDED_MINOR_VERSION,
    0, // ERL_DRV_FLAGs
    NULL, // void *handle2
          // Reserved -- Used by emulator internally
    NULL  // void (*process_exit)(ErlDrvData drv_data, ErlDrvMonitor *monitor)
};

DRIVER_INIT(MY_NAME)
{
    return &driver_entry;
}

typedef struct {
    ErlDrvPort port;
} data;

static int drv_init()
{
    async_id = 0;
    return 0;
}

static ErlDrvData drv_start(ErlDrvPort port, char* buff )
{
    data* d = (data*)driver_alloc(sizeof(data));
    d->port = port;
    return (ErlDrvData)d;
}

static void drv_stop(ErlDrvData handle)
{
    driver_free((char*)handle);
}

// decode binary/string/atom and append a trailing zero if necessary
// p must point to size + 1 bytes
// return 0 on success
//       -1 on error
// content's size must be least 1 byte, otherwise -1 is returned
// use to decode library and procedure names
int ei_decode_identificator(const char* buf, int* index,
                            char* p, int size, int type)
{
    int res = -1;
    long _len;
    if ( size > 0 )
    {    
        switch (type)
        {
        case ERL_STRING_EXT:
            res = ei_decode_string(buf, index, p);
            break;
        case ERL_BINARY_EXT:
            res = ei_decode_binary(buf, index, p, &_len);
            break;
        case ERL_ATOM_EXT:
            res = ei_decode_atom(buf, index, p);
            break;
        }
        if ( 0 == res ) p[size] = '\0';
    }
    return res;
}

int is_identificator(int type, int size)
{
    return size > 0 && ( ERL_STRING_EXT == type ||
                         ERL_BINARY_EXT == type ||
                         ERL_ATOM_EXT == type);
}

int ei_decode_string_or_binary(const char* buf, int* pindex, char* p, int size, int type)
{
    int res = -1;
    long _len;
    switch (type)
    {
    case ERL_STRING_EXT:
        res = ei_decode_string(buf, pindex, p);
        break;
    case ERL_BINARY_EXT:
        res = ei_decode_binary(buf, pindex, p, &_len);
        if ( 0 == res ) p[size] = '\0';
        ASSERT(_len == size);
        break;
    case ERL_NIL_EXT:
        res = ei_decode_list_header(buf, pindex, &size);
        p[0] = '\0';
        break;
    }
    return res;
}

// decode atom and append a trailing zero
int ei_decode_atom_as_string(const char* buf, int* index, char* p, int size)
{
    ZERO(ei_decode_atom(buf, index, p));
    p[size] = '\0';
    return 0;
}

// encode version + {Atom, Long}
// return 0 on success
int ei_encode_atom_long(char *buf, int* pindex, const char* atom, long val)
{
    ZERO(ei_encode_version(buf, pindex));
    ZERO(ei_encode_tuple_header(buf, pindex, 2));
    ZERO(ei_encode_atom(buf, pindex, atom)); 
    ZERO(ei_encode_long(buf, pindex, val));
    return 0;
}

// encode version + {Atom, Long}, use driver_alloc if necessary
// return number of bytes in *rbuf
int encode_atom_long(char **rbuf, int rlen, const char* atom, long val)
{
    int index = 0;
    ZERO(ei_encode_atom_long(NULL, &index, atom, val));
    if ( index > rlen )
        *rbuf = (char *)driver_alloc(index);
    // XXX check *rbuf
    index = 0;
    ZERO(ei_encode_atom_long(*rbuf, &index, atom, val));
    return index;
}

// encode version + {error, {Atom, Long}}
// return 0 on success
int ei_encode_error_tuple(char *buf, int* pindex, const char* atom, long val)
{
    ZERO(ei_encode_version(buf, pindex));
    ZERO(ei_encode_tuple_header(buf, pindex, 2));
    ZERO(ei_encode_atom(buf, pindex, "error"));
      ZERO(ei_encode_tuple_header(buf, pindex, 2));
      ZERO(ei_encode_atom(buf, pindex, atom));
      ZERO(ei_encode_long(buf, pindex, val));
    return 0;
}

// encode version + {error, {Atom, Int}}, use driver_alloc if necessary
// return number of bytes in *rbuf
int encode_error_tuple(char **rbuf, int rlen, const char* atom, long val)
{
    int index = 0;
    ZERO(ei_encode_error_tuple(NULL, &index, atom, val));
    if ( index > rlen )
        *rbuf = (char *)driver_alloc(index);
    // XXX check *rbuf
    index = 0;
    ZERO(ei_encode_error_tuple(*rbuf, &index, atom, val));    
    return index;
}

// encode version + {error, {Atom, String}}
// return 0 on success
int ei_encode_error_atom_string(char *buf, int* pindex, const char* atom, const char* str)
{
    ZERO(ei_encode_version(buf, pindex));
    ZERO(ei_encode_tuple_header(buf, pindex, 2));
    ZERO(ei_encode_atom(buf, pindex, "error"));
      ZERO(ei_encode_tuple_header(buf, pindex, 2));
      ZERO(ei_encode_atom(buf, pindex, atom));
      ZERO(ei_encode_string(buf, pindex, str));
    return 0;
}

// encode version + {error, {Atom, String}}, use driver_alloc if necessary
// return number of bytes in *rbuf
int encode_error_atom_string(char **rbuf, int rlen, const char* atom, const char* str)
{
    int index = 0;
    ZERO(ei_encode_error_atom_string(NULL, &index, atom, str));
    if ( index > rlen )
        *rbuf = (char *)driver_alloc(index);
    // XXX check *rbuf
    index = 0;
    ZERO(ei_encode_error_atom_string(*rbuf, &index, atom, str));
    return index;
}

// encode version + {ok, Long}, use driver_alloc if necessary
// return number of bytes in *rbuf
int encode_ok_long(char **rbuf, int rlen, long val)
{
    return encode_atom_long(rbuf, rlen, "ok", val);
}

// encode version + {error, Long}, use driver_alloc if necessary
// return number of bytes in *rbuf
int encode_error_long(char **rbuf, int rlen, long val)
{
    return encode_atom_long(rbuf, rlen, "error", val);
}

// encode version + {error, Atom}
// return 0 on success
int ei_encode_error_atom(char *buf, int* pindex, const char* atom)
{
    ZERO(ei_encode_version(buf, pindex));
    ZERO(ei_encode_tuple_header(buf, pindex, 2));
    ZERO(ei_encode_atom(buf, pindex, "error"));
    ZERO(ei_encode_atom(buf, pindex, atom));
    return 0;
}

// encode version + {error, Atom}, use driver_alloc if necessary
// return number of bytes in *rbuf
int encode_error_atom(char **rbuf, int rlen, const char* atom)
{
    int index = 0;
    ZERO(ei_encode_error_atom(NULL, &index, atom));
    if ( index > rlen )
        *rbuf = (char *)driver_alloc(index);
    // XXX check *rbuf
    index = 0;
    ZERO(ei_encode_error_atom(*rbuf, &index, atom));
    return index;
}

// encode version + {ok, {lib, Handle, CallConv}}
// return 0 on success
int ei_encode_ok_library(char *buf, int* pindex, void* Handle, long CallConv)
{
    ZERO(ei_encode_version(buf, pindex));
    ZERO(ei_encode_tuple_header(buf, pindex, 2));
      ZERO(ei_encode_atom(buf, pindex, "ok"));
      ZERO(ei_encode_tuple_header(buf, pindex, 3));
        ZERO(ei_encode_atom(buf, pindex, "lib"));
        ZERO(ei_encode_pointer(buf, pindex, Handle));
        ZERO(ei_encode_long(buf, pindex, CallConv));
    return 0;
}

// encode version + {ok, {lib, Handle, CallConv}}, use driver_alloc if necessary
// return number of bytes in *rbuf
int encode_ok_library(char **rbuf, int rlen, void* Handle, long CallConv)
{
    int index = 0;
    ZERO(ei_encode_ok_library(NULL, &index, Handle, CallConv));
    if ( index > rlen )
        *rbuf = (char *)driver_alloc(index);
    // XXX check *rbuf
    index = 0;
    ZERO(ei_encode_ok_library(*rbuf, &index, Handle, CallConv));
    return index;
}

// Call dlopen/LoadLibrary
// on success encode {ok, Library}
// on error encode {error, Reason}
// Reason = mod_not_found
//        | {winerror, ErrorCode} (on windows)
//        | {dlerror, ErrorDesc} (on anything else, ErrorDesc is obtained via dlerror())
#ifdef __WIN32__
int load_library_and_encode(char** rbuf, int rlen,
                            const char* name, int call_conv)
{
    void* h = LoadLibrary(name);
    if ( h )
        return encode_ok_library(rbuf, rlen, h, call_conv);
    else
    {
        int err = GetLastError();
        if ( ERROR_MOD_NOT_FOUND == err )
            return encode_error_atom(rbuf, rlen, "mod_not_found");
        else
            return encode_error_tuple(rbuf, rlen, "winerror", err);
    }
}
#else
int load_library_and_encode(char** rbuf, int rlen,
                            const char* name, int call_conv)
{
    void* h = dlopen(name, RTLD_LOCAL | RTLD_NOW);
    if ( h )
        return encode_ok_library(rbuf, rlen, h, call_conv);
    else
    {
        // QQQ how to return mod_not_found from here?
        return encode_error_atom_string(rbuf, rlen, "dlerror", dlerror());
    }
}
#endif

// QQQ Perhaps, instead of passing CallConv back and forth
// QQQ I should maintain a hash and consult it every time?

// Return {ok, Lib} | {error, Reason}
// Lib = {lib, Handle, CallConv}
// Lib's internal details must be used for debugging purposes only
// Reason = mod_not_found | {winerror, ErrorCode} | {dlerror, ErrorText}
// ErrorCode = integer() as returned by GetLastError()
// XXX Make ErrorCode into {winerror, integer()} | {errno, integer()}
// XXX Checkout char* erl_errno_id(int error) from erl_driver
int call_load_library(char *buf, int* pindex, char **rbuf, int rlen)
{
    char* name = 0;
    long call_conv = FFI_DEFAULT_ABI;
    int type;
    int size;
    ZERO(ei_get_type(buf, pindex, &type, &size));
    if ( is_identificator(type, size) )
    { 
        name = (char*)alloca(size + 1);
        ZERO(ei_decode_identificator(buf, pindex, name, size, type));
    }
    else if ( is_tuple(type) && 2 == size ) // {Name, CallConv}
    {
        ZERO(ei_decode_tuple_header(buf, pindex, &size));
        ZERO(ei_get_type(buf, pindex, &type, &size));
        name = (char*)alloca(size + 1);
        ZERO(ei_decode_identificator(buf, pindex, name, size, type));
        ZERO(ei_decode_long(buf, pindex, &call_conv));
    }
    else
    {
        //error(AT "badarg: %d('%c')", type, char(type));
        return -1;
    }

    ASSERT(name);
    return load_library_and_encode(rbuf, rlen, name, call_conv);
}

// encode {ptr, Pointer}
int ei_encode_ptr(char* rbuf, int* pindex, void* pointer)
{
    ZERO(ei_encode_tuple_header(rbuf, pindex, 2));
    ZERO(ei_encode_atom(rbuf, pindex, "ptr"));
    ZERO(ei_encode_pointer(rbuf, pindex, pointer));
    return 0;
}

typedef union
{
    char byte_;
    unsigned char ubyte_;
    sint8 sint8_;
    uint8 uint8_;
    sint16 sint16_;
    uint16 uint16_;
    sint32 sint32_;
    uint32 uint32_;
    sint64 sint64_;
    uint64 uint64_;
    float float_;
    double double_;
    long double longdouble_;
    int int_;
    uint uint_;
    long long_;
    ulong ulong_;
    long long longlong_;
    ulonglong ulonglong_;
    void* pointer_;
} Value;

#define ENCODE_VALUE(FFI_TYPE, TARGET_TYPE)                            \
if ( &ffi_type_ ## FFI_TYPE == type )                                  \
    return ei_encode_ ## TARGET_TYPE(rbuf, pindex,                     \
                                     (TARGET_TYPE)value.FFI_TYPE ## _)

int ei_encode_value(char *rbuf, int* pindex, Value value, ffi_type* type)
{
    if (&ffi_type_pointer == type )
        return ei_encode_ptr(rbuf, pindex, value.pointer_);
    else ENCODE_VALUE(sint32, long);
    else ENCODE_VALUE(uint32, ulong);
    else ENCODE_VALUE(sint64, longlong);
    else ENCODE_VALUE(uint64, ulonglong);
    else ENCODE_VALUE(double, double);
    else ENCODE_VALUE(sint8,  long);
    else ENCODE_VALUE(uint8,  ulong);
    else ENCODE_VALUE(sint16, long);
    else ENCODE_VALUE(uint16, ulong);
    else ENCODE_VALUE(float,  double);
    else ENCODE_VALUE(longdouble, double);
    return -1;
}

// QQQ small integer / big integer
//     small tuple / big tuple
//   this distinction might be useful to me -- if I expect
//   a tuple of size two no need to check for big tuple
//   if I expect int8 -- no need to check for big integer
//   but where are the boundaries documented?

// QQQ does ei_decode_ulong fail with negative value passed?

ffi_type* string_to_type(const char* atom)
{
#define DECODE2(FFI_TYPE, TYPE_TAG)     \
    if (0==strcmp(#TYPE_TAG, atom))     \
        return &ffi_type_ ## FFI_TYPE

#define DECODE1(X) DECODE2(X, X)    

    DECODE2(sint, int);
    else DECODE2(uint, uint);
    else DECODE2(pointer, ptr);
    else DECODE2(slong, long);
    else DECODE1(ulong);
    else DECODE2(longlong, longlong);
    else DECODE1(ulonglong);
    else DECODE1(double);
    else DECODE2(sint32, int32);
    else DECODE1(uint32);
    else DECODE2(sint64, int64);
    else DECODE1(uint64);
    else DECODE2(sint8, int8);
    else DECODE1(uint8);
    else DECODE2(sint16, int16);
    else DECODE1(uint16);
    else DECODE2(sshort, short);
    else DECODE1(ushort);
    else DECODE2(sbyte, byte);
    else DECODE1(ubyte);
    else DECODE1(float);
    else DECODE1(longdouble);
    else DECODE1(void); // XXX not valid as an argument's type

    return 0;
}

int ei_decode_ffi_type_from_atom(const char* buf, int* pindex, ffi_type** ptype)
{
    int size, type;
    char* name;
    ZERO(ei_get_type(buf, pindex, &type, &size));
    name = (char *)alloca(size + 1);
    ZERO(ei_decode_atom_as_string(buf, pindex, name, size));
    *ptype = string_to_type(name);
    if ( *ptype ) return 0;
    else return -1;
}

const char* ffi_type_to_string(ffi_type* type)
{
#define ENCODE2(FFI_TYPE, ATOM)                    \
    if ( &ffi_type_ ## FFI_TYPE == type ) return #ATOM

#define ENCODE1(X) ENCODE2(X, X)

    ENCODE2(sint32, int32);
    else ENCODE1(uint32);
    else ENCODE2(pointer, ptr);
    else ENCODE1(double);
    else ENCODE2(sint64, int64);
    else ENCODE1(uint64);
    else ENCODE1(float);
    else ENCODE2(sint8, int8);
    else ENCODE1(uint8);
    else ENCODE2(sint16, int16);
    else ENCODE1(uint16);
    else ENCODE1(longdouble);
    else ENCODE1(void);
    return 0;
}

int ei_encode_ffi_type_as_atom(char *rbuf, int* pindex, ffi_type* type)
{
    const char* atom = ffi_type_to_string(type);
    if ( atom )
        return ei_encode_atom(rbuf, pindex, atom);
    else
        return -1;
}

#define PRINT_TERM ZERO(ei_print_next_term(AT, buf, pindex))

// freeptrs can be NULL -- means skip terms where allocation is necessary
// (this is exploited by size_of; but you still have to provide valid pvalue)
// return -2 on bad type
// return -1 on ei_decode_ errors (assuming that ei_ functions return -1)
// return 0 on successful decode
int decode_arg(const char* buf, int* pindex, ffi_type** ptype,
               Value* pvalue, void** freeptrs)
{
    //PRINT_TERM;
    int type, size;
    ZERO(ei_get_type(buf, pindex, &type, &size));
    switch (type)
    {
    case ERL_SMALL_INTEGER_EXT:
    case ERL_INTEGER_EXT:
    case ERL_SMALL_BIG_EXT:
    case ERL_LARGE_BIG_EXT:
        {
            long x;
            ZERO(ei_decode_long(buf, pindex, &x));
            if ( x >= INT_MIN && x <= INT_MAX )
            {
                *ptype = &ffi_type_sint;
                pvalue->int_ = x;
                return 0;
            }
        }
        break;
    case ERL_STRING_EXT:
    case ERL_BINARY_EXT:
    case ERL_NIL_EXT:
        *ptype = &ffi_type_pointer;
        if ( freeptrs )
        {
            char* str = (char*)malloc(size + 1);
            *freeptrs = str;
            ++freeptrs;
            pvalue->pointer_ = str;
            ZERO(ei_decode_string_or_binary(buf, pindex, str, size, type));
        }
        else
        {
            pvalue->pointer_ = 0;
            ZERO(ei_skip_term(buf, pindex));
        }
        return 0;
        // XXX put binaries less than X bytes into value?
        // or pre-allocate a couple of Kb for small binaries
    case ERL_ATOM_EXT:
        {
            char* atom = (char *)alloca(size + 1);
            int saved_index = *pindex;
            ZERO(ei_decode_atom_as_string(buf, pindex, atom, size));
            if ( 0 == strcmp(atom, "null") )
            {
                *ptype = &ffi_type_pointer;
                pvalue->pointer_ = 0;
                return 0;
            }
            else
            {
                *pindex = saved_index;
                return -2;
            }
        }
        break;
    case ERL_FLOAT_EXT:
        {
            *ptype = &ffi_type_double;
            ZERO(ei_decode_double(buf, pindex, &pvalue->double_));
            return 0;
        }
    case ERL_SMALL_TUPLE_EXT:
        if ( 2 == size )
        {
            ZERO(ei_decode_tuple_header(buf, pindex, &size));
            ZERO(ei_decode_ffi_type_from_atom(buf, pindex, ptype));
            //error(ffi_type_to_string(*ptype));
            
            #define DECODE(TYPE)                               \
            if ( &ffi_type_ ## TYPE == *ptype )                \
            {                                                  \
                ZERO(ei_decode_ ## TYPE (buf,                  \
                                         pindex,               \
                                         &pvalue->TYPE ## _)); \
            }
            
            DECODE(sint32)
            else DECODE(uint32)
            else DECODE(pointer)
            else DECODE(double)
            else DECODE(sint64)
            else DECODE(uint64)
            else DECODE(float)
            else DECODE(sint8)
            else DECODE(uint8)
            else DECODE(sint16)
            else DECODE(uint16)
            else DECODE(longdouble)
            else
                return -1;
            return 0;
        }
        // no break here
    default:
        return -2;
    }
    return -1;
}

ffi_type* type_of(const char* buf, int* pindex)
{
    ffi_type* type = 0;
    Value _dont_care;
    int res = decode_arg(buf, pindex, &type, &_dont_care, 0);
    if ( -2 == res )
    {
        if (ei_decode_ffi_type_from_atom(buf, pindex, &type))
            return 0;
    }
    return type;
}

// encode version + Size_T, use driver_alloc if necessary
// return number of bytes in *rbuf
int encode_size_t(char** rbuf, int rlen, size_t value)
{
    int index = 0;
    ZERO(ei_encode_version(NULL, &index));
    ZERO(ei_encode_size_t(NULL, &index, value));
    if ( index > rlen )
        *rbuf = (char *)driver_alloc(index);
    // XXX check *rbuf
    index = 0;
    ZERO(ei_encode_version(*rbuf, &index));
    ZERO(ei_encode_size_t(*rbuf, &index, value));
    return index;
}

int call_sizeof(const char* buf, int* pindex, char** rbuf, int rlen)
{
    ffi_type* type = type_of(buf, pindex);
    if ( type )
        return encode_size_t(rbuf, rlen, type->size);
    return -1;
}

// encode version + Atom_For_Type, use driver_alloc if necessary
// return number of bytes in *rbuf
int encode_ffi_type(char** rbuf, int rlen, ffi_type* type)
{
    int index = 0;
    ZERO(ei_encode_version(NULL, &index));
    ZERO(ei_encode_ffi_type_as_atom(NULL, &index, type));
    if ( index > rlen )
        *rbuf = (char *)driver_alloc(index);
    // XXX check *rbuf
    index = 0;
    ZERO(ei_encode_version(*rbuf, &index));
    ZERO(ei_encode_ffi_type_as_atom(*rbuf, &index, type));
    return index;
}

int call_typeof(const char* buf, int* pindex, char** rbuf, int rlen)
{
    ffi_type* type = type_of(buf, pindex);
    if ( type )
        return encode_ffi_type(rbuf, rlen, type);
    return -1;
}

// almost equivalent to ei_decode_list_header, but not quite:
// Erlang encodes lists of small integers as string:
// call(sleep, [32]) receives " ".
// so we have to check for this annoying case
// we could have used tuple for Args, but list seems more natural
// from erlang's perspective
int decode_args_list_header(const char* buf, int* pindex,
                            int* parity, int* psmall_ints)
{
    int type;
    ZERO(ei_get_type(buf, pindex, &type, parity));
    if ( ERL_STRING_EXT == type )
        *psmall_ints = 1;
    else
        return ei_decode_list_header(buf, pindex, parity);
    return 0;
}

typedef void (*FPTR)();

typedef struct
{
    void* hlibrary;
    ffi_abi abi;
    FPTR myfunc;
    ffi_type* res_type;
    Value result;
    Value* arguments;
    ffi_type** types;
    void** values;
    void** freeptrs; // memory blocks to free after call
    int arity;
    ffi_cif cif;

    // following fields required only for async calls.
    // XXX separate them into another structure AsyncCallInfo { CallInfo c; ..}
    ErlDriverTerm caller;
    long async_handle;
} CallInfo;

void call_info_init(CallInfo* c)
{
    c->abi = FFI_DEFAULT_ABI;
    c->myfunc = 0;
    c->res_type = &ffi_type_sint;
    c->arguments = 0;
    c->types = 0;
    c->freeptrs = 0;
    c->values = 0;
}

int ei_decode_nil(const char* buf, int* pindex)
{
    int size;
    return ei_decode_list_header(buf, pindex, &size);
}

// return 0 on success
// return i when argument #i has inappropriate type (counting from 1)
// list's header must be already read
int call_info_decode_args_list(const char* buf, int* pindex, CallInfo* c)
{
    int i;
    for ( i = 0; i < c->arity; ++i )
    {
        if ( decode_arg(buf, pindex, &c->types[i],
                        &c->arguments[i], c->freeptrs ) )
            return i + 1;
    }
    if ( c->arity)
        ZERO(ei_decode_nil(buf, pindex));
    return 0;
}

// for nasty special case when list was encoded as string
int call_info_decode_args_string(const char* buf, int* pindex, CallInfo* c)
{
    int i;
    char* data = (char *)alloca(c->arity + 1);
    ZERO(ei_decode_string(buf, pindex, data));
    for ( i = 0; i < c->arity; ++i )
    {
        c->types[i] = &ffi_type_sint;
        c->arguments[i].int_ = data[i];
    }
    return 0;
}

// msvc version of ffi_call return int (0 - success)
// other versions of ffi_call return void
// this is the lowest common denominator
int _ffi_call(ffi_cif *cif, void * fn,  void *rvalue, void **avalue)
{
#ifdef FFI_CALL_RETURN_INT
    return ffi_call(cif, (FPTR)fn, rvalue, avalue);
#else
    ffi_call(cif, (FPTR)fn, rvalue, avalue);
    return 0;
#endif
}

int ei_decode_ffi_abi(const char* buf, int* pindex, ffi_abi* pabi)
{
    return ei_decode_int(buf, pindex, (int*)pabi);
}

int decode_param(const char* buf, int* pindex,
                 ffi_abi* pabi, ffi_type** res_type)
{
    int tuple_size;
    ZERO(ei_decode_tuple_header(buf, pindex, &tuple_size));
    if ( 2 == tuple_size )
    {
        int type, atom_size;
        char* atom;
        ZERO(ei_get_type(buf, pindex, &type, &atom_size));
        atom = (char *)alloca(atom_size + 1);
        ZERO(ei_decode_atom_as_string(buf, pindex, atom, atom_size+1));
        if ( 0 == strcmp(atom, "res_type") )
        {
            ZERO(ei_decode_ffi_type_from_atom(buf, pindex, res_type));
            return 0;
        }
        else if ( 0 == strcmp(atom, "abi") )
        {
            ZERO(ei_decode_ffi_abi(buf, pindex, pabi));
            return 0;
        }
    }
    return -1;
}

// return 0 on success
int decode_params_list(const char* buf, int* pindex, ffi_abi* pabi,
                       ffi_type** res_type)
{
    int list_size;
    int i;
    ZERO(ei_decode_list_header(buf, pindex, &list_size));
    for ( i = 0; i < list_size; ++i )
    {
        ZERO(decode_param(buf, pindex, pabi, res_type));
    }
    if ( list_size )
        ZERO(ei_decode_nil(buf, pindex));
    return 0;
}

int ei_decode_this_atom(const char* buf, int* pindex, const char* atom)
{
    int type, size;
    char* name;
    ZERO(ei_get_type(buf, pindex, &type, &size));
    if ( size != (int)strlen(atom) )
        return -1;
    name = (char*)alloca(size + 1);
    ZERO(ei_decode_atom_as_string(buf, pindex, name, size));
    if (0 == strcmp(atom, name)) return 0;
    return -1;
}

// decode Library = {lib, Handle, CallConv}
// return 0 on success
int decode_library(const char* buf, int* pindex, void** phlib, ffi_abi* pabi)
{
    int size;
    ZERO(ei_decode_tuple_header(buf, pindex, &size));
    NONZERO(3 == size);
    ZERO(ei_decode_this_atom(buf, pindex, "lib"));
    ZERO(ei_decode_ulong(buf, pindex, (ulong*)phlib));
    ZERO(ei_decode_ffi_abi(buf, pindex, pabi));
    return 0;
}

// Call dlsym/GetProcAddress, return 0 on success
// on error, encode {error, Reason} in rbuf, return number of bytes encoded
#ifdef __WIN32__
int dlsym_or_encode(char** rbuf, int rlen, void* hlibrary,
                    const char* name, FPTR* pfunc)
{
    *pfunc = (FPTR)GetProcAddress((HMODULE)hlibrary, name);
    if ( *pfunc )
        return 0;
    else
    {
        int err = GetLastError();
        if ( ERROR_PROC_NOT_FOUND == err )
            return encode_error_atom(rbuf, rlen, "proc_not_found");
        else
            return encode_error_tuple(rbuf, rlen, "winerror", err);
    }
}
#else
int dlsym_or_encode(char** rbuf, int rlen, void* hlibrary,
                    const char* name, FPTR* pfunc)
{
    *pfunc = (FPTR)dlsym(hlibrary, name);
    if ( *pfunc )
        return 0;
    else
    {
        // QQQ how to return proc_not_found from here?
        return encode_error_atom_string(rbuf, rlen, "dlerror", dlerror());
    }
}
#endif

// decode Proc = identificator()| {proc, Fptr, Params}
// Params = [] | [CallConv]
// return 0 on success
int decode_proc(const char* buf, int* pindex, void* hlibrary,
                FPTR* pfunc, ffi_abi* abi, char** rbuf, int rlen)
{
    int type, size;
    ZERO(ei_get_type(buf, pindex, &type, &size));
    if ( is_tuple(type) && 3 == size )
    {
        error(AT "Not implemented");
    }
    else
    {        
        char* name = (char*)alloca(size + 1);
        ZERO(ei_decode_identificator(buf, pindex, name, size, type));
        return dlsym_or_encode(rbuf, rlen, hlibrary, name, pfunc);
    }
    return -1;
}

void freeall(void** freeptrs, int size)
{
    int i;
    for ( i = 0; i < size; ++i )
    {
        if ( freeptrs[i] )
            free(freeptrs[i]);
        else
            break;
    }
}

// decode Lib, Func, Params
int decode_lib_func_params(const char* buf, int* pindex,
                           char** rbuf, int rlen,
                           CallInfo* c, int* psmall_ints)
{
    ZERO(decode_library(buf, pindex, &c->hlibrary, &c->abi));
    ZERO(decode_proc(buf, pindex, c->hlibrary,
                     &c->myfunc, &c->abi, rbuf, rlen));
    ASSERT(c->myfunc);
    ZERO(decode_params_list(buf, pindex, &c->abi, &c->res_type));
    ZERO(decode_args_list_header(buf, pindex, &c->arity, psmall_ints));
    return 0;
}

// buf must contain {Lib, Func, Params, Args}
// decode first three and read the size of the Args
int decode_call_info(const char* buf, int* pindex, CallInfo* pc,
                     char** rbuf, int rlen, int* psmall_ints)
{
    int tuple_size;
    call_info_init(pc);
    ZERO(ei_decode_tuple_header(buf, pindex, &tuple_size));
    // {Lib, Func, Params, Args}    
    NONZERO(4==tuple_size);
    ZERO(decode_lib_func_params(buf, pindex, rbuf, rlen, pc, psmall_ints));
    return 0;
}

void call_info_setup_values(CallInfo* c)
{
    int i;
    for ( i = 0; i < c->arity; ++i )
        c->values[i] = &c->arguments[i];
}

// return 0 on success
// encode error and return index on error
int call_info_prep_cif(const char* buf, int* pindex,
                       CallInfo* c, char** rbuf,
                       int rlen, int small_ints)
{
    int bad_arg_num;
    int ffi_prep_res;
    
    if ( small_ints )
        bad_arg_num = call_info_decode_args_string(buf, pindex, c);
    else
        bad_arg_num = call_info_decode_args_list(buf, pindex, c);

    if ( bad_arg_num )
        return encode_error_tuple(rbuf, rlen, "badarg", bad_arg_num);
    ffi_prep_res = ffi_prep_cif(&c->cif, c->abi, c->arity,
                                    c->res_type, c->types);
    if ( FFI_OK != ffi_prep_res )
        return encode_error_tuple(rbuf, rlen, "ffi_prep_cif", ffi_prep_res);
    return 0;
}

// encode version + {ok, Value}
// Value = ok | integer() | double() | {ptr, Unsigned}
// return 0 on success
int ei_encode_ok_value(char *buf, int* pindex, Value value, ffi_type* type)
{
    ZERO(ei_encode_version(buf, pindex));
    if ( &ffi_type_void == type )
    {
        ZERO(ei_encode_tuple_header(buf, pindex, 2));
        ZERO(ei_encode_atom(buf, pindex, "ok"));
        ZERO(ei_encode_atom(buf, pindex, "ok"));
    }
    else
    {
        ZERO(ei_encode_tuple_header(buf, pindex, 2));
        ZERO(ei_encode_atom(buf, pindex, "ok"));
        ZERO(ei_encode_value(buf, pindex, value, type));
    }
    return 0;
}

// encode version + {ok, Value}, use driver_alloc if necessary
// Value = ok | integer() | double() | {ptr, Unsigned}
// return number of bytes in *rbuf
int encode_ok_value(char **rbuf, int rlen, Value value, ffi_type* type)
{
    int index = 0;
    ZERO(ei_encode_ok_value(NULL, &index, value, type));
    if ( index > rlen )
        *rbuf = (char *)driver_alloc(index);
    index = 0;
    ZERO(ei_encode_ok_value(*rbuf, &index, value, type));
    return index;   
}

// XXX what will happen when arity == 0
// alloca(0)? malloc(0)? no matter what it's better not to call them

// Return {ok, Result} | {error, Reason}
int call_block(const char* buf, int* pindex, char** rbuf, int rlen)
{
    CallInfo c;
    int small_ints = 0;
    int res;
    ZERO(decode_call_info(buf, pindex, &c, rbuf, rlen, &small_ints));

    if ( c.arity )
    {
        c.arguments = (Value*)alloca(c.arity * sizeof(Value));
        c.types = (ffi_type**)alloca(c.arity * sizeof(ffi_type*));
        c.freeptrs = (void**)alloca(c.arity * sizeof(void*));
        memset(c.freeptrs, 0, c.arity * sizeof(void*));
        c.values = (void**)alloca(c.arity * sizeof(void*));
    }

    res = call_info_prep_cif(buf, pindex, &c, rbuf, rlen, small_ints);
    if ( res == 0)
    {
        int delta;
        call_info_setup_values(&c);
        delta = _ffi_call(&c.cif, (void *)c.myfunc, &c.result, c.values);
        if ( delta )
        {
            error(AT "ffi_call delta=%d", delta);
            res = encode_error_tuple(rbuf, rlen, "delta", delta);
        }
        else
            res = encode_ok_value(rbuf, rlen, c.result, c.res_type);
    }
    freeall(c.freeptrs, c.arity);
    return res;
}

void free_call_info(CallInfo* c)
{
    free(c->values);
    freeall(c->freeptrs, c->arity);
    free(c->freeptrs);
    free(c->types);
    free(c->arguments);
    free(c);
}

void invoke(void* param)
{
    CallInfo* c = (CallInfo*)param;
    int delta = _ffi_call(&c->cif, (void *)c->myfunc, &c->result, c->values);
    if ( delta )
    {
        error(AT "ffi_call delta=%d", delta);
        c->res_type = 0; // indicates that ffi_call has failed
        c->result.int_ = delta;
    }
}

int call_async(ErlDrvPort port, const char* buf, int* pindex,
               char** rbuf, int rlen)
{
    CallInfo* c = (CallInfo*)malloc(sizeof(CallInfo));
    int small_ints = 0;
    int res;
    long c_async_handle;
    
    ZERO(decode_call_info(buf, pindex, c, rbuf, rlen, &small_ints));

    if ( c->arity )
    {
        c->arguments = (Value*)malloc(c->arity * sizeof(Value));
        c->types = (ffi_type**)malloc(c->arity * sizeof(ffi_type*));
        c->freeptrs = (void**)calloc(c->arity, sizeof(void*));
        c->values = (void**)malloc(c->arity * sizeof(void*));
        // XXX I would like to combine all those mallocs into one
    }

    res = call_info_prep_cif(buf, pindex, c, rbuf, rlen, small_ints);
    if ( res )
    {
        free_call_info(c);
        return res;
    }
    
    call_info_setup_values(c);
    c->caller = driver_caller(port);

    // QQQ Unfortunately, I cannot send async_handle back to erlang,
    //     since invoke may be called before driver_async return.
    //     returning async_handle would be a good thing, because
    //     I wouldn't have to maintain my own id and because I could have
    //     exposed driver_async_cancel to erlang and let user control this aspect
    //     If only driver_async(...) was splitted into two steps:
    //       1. id = alloc_driver_async_id(...)
    //       2. driver_async_with_preallocated_id(id, ...)
    //    then I could have updated c->async_handle = id
    c_async_handle = c->async_handle = next_id();
    driver_async(port, 0, invoke, c, 0);
    // WARNING: c may be already freed there
    return encode_atom_long(rbuf, rlen, "async", c_async_handle);
}

// send {async_error, Handle, not_implemented} to caller
void driver_send_error_notimpl(ErlDrvPort port, ErlDriverTerm caller,
                               long Handle)
{
    ErlDriverTerm spec[] = {
        ERL_DRV_ATOM, driver_mk_atom("async_error"),
        ERL_DRV_INT, Handle,
        ERL_DRV_ATOM, driver_mk_atom("not_implemented"),
        ERL_DRV_TUPLE, 3
    };
    driver_send_term(port, caller, spec, sizeof(spec)/sizeof(spec[0]));
}

// send {async_ok, Handle, ok} to caller
void driver_send_ok(ErlDrvPort port, ErlDriverTerm caller, long Handle)
{
    ErlDriverTerm spec[] = {
        ERL_DRV_ATOM, driver_mk_atom("async_ok"),
        ERL_DRV_INT, Handle,
        ERL_DRV_ATOM, driver_mk_atom("ok"),
        ERL_DRV_TUPLE, 3
    };
    driver_send_term(port, caller, spec, sizeof(spec)/sizeof(spec[0]));
}

// send {async_ok, Handle, Val} to caller
void driver_send_ok_integer(ErlDrvPort port, ErlDriverTerm caller,
                            long Handle, int val)
{
    ErlDriverTerm spec[] = {
        ERL_DRV_ATOM, driver_mk_atom("async_ok"),
        ERL_DRV_INT, Handle,
        ERL_DRV_INT, val,
        ERL_DRV_TUPLE, 3
    };
    driver_send_term(port, caller, spec, sizeof(spec)/sizeof(spec[0]));
}

// send {async_ok, Handle, val} to caller
void driver_send_ok_double(ErlDrvPort port, ErlDriverTerm caller,
                           long Handle, double val)
{
    ErlDriverTerm spec[] = {
        ERL_DRV_ATOM, driver_mk_atom("async_ok"),
        ERL_DRV_INT, Handle,
        ERL_DRV_FLOAT, (ErlDriverTerm)&val,
        ERL_DRV_TUPLE, 3
    };
    driver_send_term(port, caller, spec, sizeof(spec)/sizeof(spec[0]));
}

void driver_send_ok_uint64(ErlDrvPort port, ErlDriverTerm caller,
                          long Handle, uint64 val)
{
    ErlDriverTerm spec[] = {
        ERL_DRV_ATOM, driver_mk_atom("async_ok"),
        ERL_DRV_INT, Handle,        
          ERL_DRV_INT, val>>32,
          ERL_DRV_INT, val&0xffffffff,
          ERL_DRV_TUPLE, 2,
        ERL_DRV_TUPLE, 3
    };
    driver_send_term(port, caller, spec, sizeof(spec)/sizeof(spec[0]));
}

// send {async_ok, Handle, Result} | {async_ok, Handle} to caller
// XXX trouble: there exists ERL_DRV_INT, but nothing else for larger integers:
// unsigned int, long, long long
// That means I have to
// 1) (on 32 bit) put uint32/void* into int, then fix negative values
//    on the other (erlang) side
//    use something else for int64/uint64
// 2) (on 64 bit) use something else (2 integers in a row? binary?) for
//    uint32/void*/int64/uint64
#if LONG_MAX!=sint32_MAX
#error "64bit support is weak! Comment this out if you still want\
 to compile, but you have been warned"
#endif

#define DRIVER_SEND_INTEGER(TYPE)                   \
if (&ffi_type_ ## TYPE == type)                     \
    driver_send_ok_integer(port, caller,            \
                           Handle, value.TYPE ## _)

void driver_send_ok_result(ErlDrvPort port, ErlDriverTerm caller,
                           long Handle, Value value, ffi_type* type)
{
    //error(AT "type=%s value.sint32_=%d", ffi_type_to_string(type), value.sint32_);
    
    if ( &ffi_type_pointer == type )
    {
        if ( sizeof(int) == sizeof(void*) )
            driver_send_ok_integer(port, caller,
                                   Handle, (int)value.pointer_);
        else
        {
            // XXX Pack as uint
            error("{res_type, ptr} is not implemented for 64bit");
            driver_send_error_notimpl(port, caller, Handle);
        }
    }
    else if ( &ffi_type_void == type )
        driver_send_ok(port, caller, Handle);
    else DRIVER_SEND_INTEGER(sint32);
    else DRIVER_SEND_INTEGER(uint32);
    else DRIVER_SEND_INTEGER(sint8);
    else DRIVER_SEND_INTEGER(uint8);
    else DRIVER_SEND_INTEGER(sint16);
    else DRIVER_SEND_INTEGER(uint16);
    else if ( &ffi_type_sint64 == type || &ffi_type_uint64 == type )
        driver_send_ok_uint64(port, caller, Handle, value.uint64_);
    else if (&ffi_type_double == type )
        driver_send_ok_double(port, caller, Handle, value.double_);
    else if (&ffi_type_float == type )
        driver_send_ok_double(port, caller, Handle, value.float_);
    else if (&ffi_type_longdouble == type )
        driver_send_ok_double(port, caller, Handle,
                              (double)value.longdouble_);
}

// send {async_error, {delta, Value}} to caller
void driver_send_error_delta(ErlDrvPort port, ErlDriverTerm caller, int delta)
{
    ErlDriverTerm spec[] = {
        ERL_DRV_ATOM, driver_mk_atom("error"),
          ERL_DRV_ATOM, driver_mk_atom("delta"),
          ERL_DRV_INT, delta,
          ERL_DRV_TUPLE, 2,
        ERL_DRV_TUPLE, 2
    };

    driver_send_term(port, caller, spec,
                     sizeof(spec)/sizeof(spec[0]));
}

void ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data)
{
    data* d = (data*)drv_data;
    CallInfo* c = (CallInfo*)thread_data;
    if ( c->res_type )
        driver_send_ok_result(d->port, c->caller, c->async_handle,
                              c->result, c->res_type);
    else
    {
        int delta = c->result.int_;
        error(AT "ffi_call delta=%d", delta);
        driver_send_error_delta(d->port, c->caller, delta);
    }
    
    free_call_info(c);
}

int drv_call(ErlDrvData drv_data, unsigned int command, char *buf, int len,
             char **rbuf, int rlen, unsigned int *flags)
{
    int version;
    int buf_index = 0;
    ZERO(ei_decode_version(buf, &buf_index, &version));

    switch (command)
    {
    case CMD_CALL_ASYNC:
        return call_async(((data*)drv_data)->port,
                          buf, &buf_index, rbuf, rlen);
        
    case CMD_CALL_BLOCK:
        return call_block(buf, &buf_index, rbuf, rlen);
        
    case CMD_LOAD_LIBRARY:
        return call_load_library(buf, &buf_index, rbuf, rlen);
        
    case CMD_SIZE_OF:
        return call_sizeof(buf, &buf_index, rbuf, rlen);

    case CMD_TYPE_OF:
        return call_typeof(buf, &buf_index, rbuf, rlen);        

    case CMD_GET_VERSION:
        return encode_atom_long(rbuf, rlen, "version", VERSION);
        
    case CMD_TEST_PRINT_TYPE:
        {
            int type, size;
            int index = 0;            
            ZERO(ei_get_type(buf, &buf_index, &type, &size));
            error("type = %c(%d), size = %d", (char)type, type, size);
            ZERO(ei_encode_version(*rbuf, &index));
            ZERO(ei_encode_atom(*rbuf, &index, "ok"));
            return index;
        }
    }
    return -1;
}
